home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / tbox100 / toolbox.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1995-05-08  |  8.1 KB  |  223 lines
  1. VERSION 2.00
  2. Begin Form frmtoolBox 
  3.    BackColor       =   &H00C0C0C0&
  4.    BorderStyle     =   0  'None
  5.    ClientHeight    =   5985
  6.    ClientLeft      =   2040
  7.    ClientTop       =   1725
  8.    ClientWidth     =   1170
  9.    ClipControls    =   0   'False
  10.    ControlBox      =   0   'False
  11.    Height          =   6390
  12.    Icon            =   0
  13.    KeyPreview      =   -1  'True
  14.    Left            =   1980
  15.    LinkTopic       =   "Form1"
  16.    MaxButton       =   0   'False
  17.    MinButton       =   0   'False
  18.    ScaleHeight     =   399
  19.    ScaleMode       =   3  'Pixel
  20.    ScaleWidth      =   78
  21.    Top             =   1380
  22.    Width           =   1290
  23.    Begin PictureBox MsgBlaster1 
  24.       BackColor       =   &H000000FF&
  25.       Height          =   1000
  26.       Left            =   0
  27.       ScaleHeight     =   975
  28.       ScaleWidth      =   975
  29.       TabIndex        =   0
  30.       Top             =   0
  31.       Width           =   1000
  32.    End
  33.    Begin Shape Shape1 
  34.       BorderColor     =   &H80000006&
  35.       Height          =   5985
  36.       Left            =   0
  37.       Top             =   0
  38.       Width           =   1170
  39.    End
  40. Option Explicit
  41. Dim toolBoxActive As Integer
  42. Dim hSysMenu As Long
  43. 'Menu ID's
  44. Const IDM_SYSMOVE = 101
  45. Const IDM_SYSCLOSE = 102
  46. Sub Form_KeyDown (keyCode As Integer, Shift As Integer)
  47.     If (keyCode = 32) And (Shift = 4) Then
  48.         keyCode = 0
  49.         Shift = 0
  50.         DoEvents
  51.         ShowSysMenu
  52.         End If
  53.     If (keyCode = 115) And (Shift = 4) Then
  54.         keyCode = 0
  55.         Shift = 0
  56.         frmMain!mnuToolbox.Checked = False
  57.         Hide
  58.         End If
  59.     End Sub
  60. Sub Form_Load ()
  61.   Dim i%
  62.   ' Make the toolbox a top-most window
  63.   i% = SetWindowPos(hWnd, HWND_TOPMOST, 0, 0, 0, 0, FLAGS)
  64.   ' Set up message blaster to respond to desired events...
  65.   MsgBlaster1.hWndTarget = hWnd
  66.   MsgBlaster1.MsgList(0) = WM_NCHITTEST
  67.   MsgBlaster1.MsgPassage(0) = EATMESSAGE
  68.   MsgBlaster1.MsgList(1) = WM_CLOSE
  69.   MsgBlaster1.MsgList(2) = WM_NCACTIVATE
  70.   MsgBlaster1.MsgList(3) = WM_NCLBUTTONDBLCLK
  71.   MsgBlaster1.MsgPassage(3) = EATMESSAGE
  72.   MsgBlaster1.MsgList(4) = WM_NCLBUTTONDOWN
  73.   MsgBlaster1.MsgList(5) = WM_COMMAND
  74.   MsgBlaster1.MsgPassage(5) = PREPROCESS
  75.   MsgBlaster1.MsgList(6) = WM_ACTIVATEAPP
  76.   ' Create our fake system menu for the toolbox
  77.   ' (I don't use VBs own popup menu function because it lacks
  78.   ' the full functionality of the API function)
  79.   hSysMenu = CreatePopupMenu()
  80.   i% = AppendMenu(hSysMenu, MF_ENABLED Or MF_STRING, IDM_SYSMOVE, "&Move")
  81.   i% = AppendMenu(hSysMenu, MF_ENABLED Or MF_STRING, IDM_SYSCLOSE, "&Close  Alt+F4")
  82.   End Sub
  83. Sub Form_Paint ()
  84.   'Refresh the title bar and system menu.  The paint event gets
  85.   'called each time the system colors are changed, so we keep
  86.   'up to date on the fly...
  87.   'Vertical line beteen control menu and caption
  88.   '(using the windowframe system color)
  89.   Line (BAR_HEIGHT + 1, 1)-(BAR_HEIGHT + 1, BAR_HEIGHT + 1), WINDOW_FRAME
  90.   'Horizontal line below caption (using the windowframe
  91.   'system color)
  92.   Line (1, BAR_HEIGHT + 1)-(scaleWidth, BAR_HEIGHT + 1), WINDOW_FRAME
  93.   'Fill in control menu (always light gray)
  94.   Line (1, 1)-(BAR_HEIGHT, BAR_HEIGHT), QBColor(7), BF
  95.   'Box for bar in control menu (always black)
  96.   Line (2, (BAR_HEIGHT - 1) \ 2)-Step(BAR_HEIGHT - 4, 2), QBColor(0), B
  97.   'Line inside bar in control menu (always white)
  98.   Line (3, (BAR_HEIGHT - 1) \ 2 + 1)-Step(BAR_HEIGHT - 5, 0), QBColor(15)
  99.   'Vertical shadow on bar in control menu (always dark gray)
  100.   Line (BAR_HEIGHT - 1, (BAR_HEIGHT - 1) \ 2 + 1)-Step(0, 3), QBColor(8)
  101.   'Horizontal shadow on bar in control menu (always dark gray)
  102.   Line (3, (BAR_HEIGHT - 1) \ 2 + 3)-Step(BAR_HEIGHT - 4, 0), QBColor(8)
  103.   titleBar
  104.   End Sub
  105. Sub MsgBlaster1_Message (MsgVal As Integer, wParam As Integer, lParam As Long, lRetVal As Long)
  106.   Dim i%, tc&
  107.   Dim FormTop%
  108.   Dim FormLeft%
  109.   Dim xPos%
  110.   Dim yPos%
  111.   'Which message has come to us?
  112.   Select Case MsgVal
  113.   Case WM_ACTIVATEAPP
  114.     'The WM_ACTIVATEAPP message means our app is losing or
  115.     'gaining the focus.  We check this so we can show or hide
  116.     'the floating toolbox.
  117.     If wParam Then
  118.       If frmMain.WindowState <> 1 And frmMain!mnuToolbox.Checked Then frmToolBox.Show
  119.     Else
  120.       Hide
  121.       End If
  122.     lRetVal = 0
  123.   Case WM_NCACTIVATE
  124.     'The WM_NCACTIVATE message means the non-client area of a
  125.     'window requires updating due to a change in the activation
  126.     'state of that window.  All we need to redraw is the title
  127.     'bar.
  128.     If wParam Then
  129.       toolBoxActive = True
  130.     Else
  131.       toolBoxActive = False
  132.       End If
  133.     titleBar
  134.   Case WM_CLOSE
  135.     'Close has been selected from the system menu.
  136.     frmMain!mnuToolbox.Checked = False
  137.     Hide
  138.   Case WM_NCHITTEST
  139.     'This is the magic bit - windows tells us that the user is
  140.     'moving the mouse over our window - it wants us to tell it
  141.     'WHAT the mouse is moving over, so we oblige.  Then, when
  142.     'the user clicks, windows thinks the user has clicked on
  143.     'whatever we have told it the mouse was over.
  144.     FormTop% = top / screen.TwipsPerPixelY
  145.     FormLeft% = Left / screen.TwipsPerPixelX
  146.     xPos% = (lParam And &HFFFF&) - FormLeft%
  147.     yPos% = (lParam / 65536) - FormTop%
  148.     If (yPos% < BAR_HEIGHT + 2) And (xPos% < BAR_HEIGHT + 2) Then
  149.       'Tell windows the mouse is over the system menu...
  150.       lRetVal = HTSYSMENU
  151.     ElseIf (yPos% < BAR_HEIGHT + 2) Then
  152.       'Tell windows the mouse is over the title bar...
  153.       lRetVal = HTCAPTION
  154.     Else
  155.       ' Tell windows the mouse is over the client area...
  156.       lRetVal = HTCLIENT
  157.       End If
  158.   Case WM_NCLBUTTONDBLCLK
  159.     'A double click in the non-client area!  If it is over the
  160.     'system menu then we close (hide) the toolbox...
  161.     If wParam = HTSYSMENU Then
  162.       frmMain!mnuToolbox.Checked = False
  163.       Hide
  164.       End If
  165.   Case WM_NCLBUTTONDOWN
  166.     'A buttondown in the non-client area!  If it is over the
  167.     'system menu then we show the system menu...
  168.     If wParam = HTSYSMENU Then
  169.       ShowSysMenu
  170.       End If
  171.   Case WM_COMMAND
  172.     'A command message (meaning a command button or menu-item
  173.     'has been selected).
  174.     Select Case wParam
  175.       Case IDM_SYSMOVE
  176.         'If the move menu item was selected, send a move command.
  177.         tc& = SendMessage(hWnd, WM_SYSCOMMAND, SC_MOVE, 0)
  178.       Case IDM_SYSCLOSE
  179.         'If the close menu item was selected, close the window.
  180.         frmMain!mnuToolbox.Checked = False
  181.         Hide
  182.     End Select
  183.   End Select
  184. End Sub
  185. Sub ShowSysMenu ()
  186.   Dim ScreenRect As Rect
  187.   Dim InPixels As Single
  188.   Dim IX As Single
  189.   Dim IY As Single
  190.   Dim RC%
  191.   'Set up the rectangle that defines an area where the mouse
  192.   'can be clicked without dismissing the menu.  This lets the
  193.   'user click and release over the system menu and the menu
  194.   'stays up.  VBs built in popup menu function doesn't support
  195.   'this.
  196.   ScaleMode = 1
  197.   ScreenRect.Left = Left \ screen.TwipsPerPixelX
  198.   ScreenRect.Right = ScreenRect.Left + BAR_HEIGHT + 2
  199.   ScreenRect.top = top \ screen.TwipsPerPixelY
  200.   ScreenRect.bottom = ScreenRect.top + BAR_HEIGHT + 2
  201.   ScaleMode = 3
  202.   IX = ScreenRect.Left
  203.   IY = ScreenRect.bottom - 1
  204.   'If the menu will go off the bottom of the screen, make it
  205.   'draw ABOVE the control box.  Note that Windows won't draw a
  206.   'menu off the screen, but it will draw it covering the control
  207.   'box.  Normal control menus don't do this.
  208.   If (IY + 2 * GetSystemMetrics(SM_CYMENU) + 3) > (screen.Height \ screen.TwipsPerPixelY) Then IY = IY - (2 * GetSystemMetrics(SM_CYMENU)) - 12
  209.   RC% = TrackPopupMenu(hSysMenu, 0, IX, IY, 0, hWnd, ScreenRect)
  210.   End Sub
  211. Sub titleBar ()
  212.   'Paint titleBar
  213.   If toolBoxActive Then
  214.     'If the toolbox is the active window then paint
  215.     'with the active title bar color
  216.     Line (BAR_HEIGHT + 2, 1)-Step(scaleWidth - BAR_HEIGHT - 4, BAR_HEIGHT - 1), ACTIVE_TITLE_BAR, BF
  217.   Else
  218.     'If the toolbox is inactive then paint with the
  219.     'inactive title bar color
  220.     Line (BAR_HEIGHT + 2, 1)-Step(scaleWidth - BAR_HEIGHT - 4, BAR_HEIGHT - 1), INACTIVE_TITLE_BAR, BF
  221.     End If
  222.   End Sub
  223.